 PAG
*********************************
*  SEGSEVENFONE
*********************************

 ORG $C800  ;CODE RUNS HERE

* THIS SPACE IS SHARED WITH THE VIA AND THE RAM.

MSGSWSET
MSGMNE ASC "mne "84
MSGAUX ASC "aux "84
MSGROM ASC "rom "84
MSGRAM ASC "ram "84
MSG1 ASC " 1  "84
MSG2 ASC " 2  "84
MSGOFF ASC "off "84
MSGON ASC "on  "84
MSGOUT ASC "out "84
MSGIN ASC "in  "84
MSG02 ASC "02  "84
MSGC02 ASC "C02 "84
MSG816 ASC "802 "84
MSGCR DFB CR,CR,CR," ",EOT

****************************************
* THIS POINT MUST BE $CA00 OR ABOVE.
****************************************

 DS $CA00-*,$FF

********************************
*  I/O ROUTINES
********************************

CROUTN EQU *
CROUT LDA #$8D  ;CARRIAGE RETURN
COUT JSR SETRTS  ;SAVE STUFF IF NEEDED
 BIT IOMODE  ;CHECK I/O MODE
 BVS SEND  ;OUTPUT TO SLOT1
 BMI SEND  ;SERIAL I/O
 BIT OFFFLAG  ;DISPLAY ENABLED?
 BPL :DISP  ;IF YES
 CMP #$87  ;BELL ?
 BEQ :DISP  ;IF YES RING EVEN IF DISPLAY OFF
 CLC   ;clear "esc" flag
* DISLAY IS OFF SO DON'T DISPLAY
 RTS

:DISP JMP TOCOUT

SPACE LDA #$A0  ;SPACE
 BNE COUT  ;<ALWAYS>

PRERR LDA #"E"
 JSR COUT
 LDA #"R"
 JSR COUT
 JSR COUT

BELL LDA #$87  ;BELL CHAR
 BNE COUT

RDCHAR BIT IOMODE  ;SERIAL I/O?
 BMI RECEIVE  ;IF YES
 JSR SETRTS  ;INIT DISPLAY FOR EXTII OUTPUT
:OFF JSR TRANSFR7 ;READ CHARACTER
 DFB TORDCHARC ;code
 RTS

PRNTAX JSR PRBYTE
 TXA

PRBYTE PHA
 LSR
 LSR
 LSR
 LSR
 JSR PRHEX
 PLA
 AND #$0F
PRHEX ORA #$B0
 CMP #$BA
 BCC COUT
 ADC #$06
 JMP COUT

PRBLNK LDX #3

PRBL2 LDA #$A0
XSPACES JSR COUT
 DEX
 BNE XSPACES
 RTS

******* Pascal 1.1 I/O  ******

SEND JSR TRANSFR7 ;OUTPUT TO Pascal 1.1 I/O
 DFB OUTPASCLC ;code
 RTS

RECEIVE JSR TRANSFR7 ;INPUT FROM Pascal 1.1 I/O
 DFB INPASCALC ;code
 RTS

************ SETRTS ************

* TURN ON THE FLAG INDICATING THE SCREEN
* RAM HAS BEEN CHANGED BY EXTERM.

SETRTS PHA   ;SAVE ACC & X
 TXA
 PHA
 TYA
 PHA   ;SAVE Y
 BIT INITFLAG ;HAS THE USER PROGRAM BEEN EXECUTED?
 BPL :ZPOK  ;IF NO
 JSR TRANSFR7 ;SAVE SCREEN SWITCHES, TXT RAM IF INVIS
 DFB ZPAGSAVEC ;code
 BIT OFFFLAG  ;DISPLAY OFF ?
 BMI :NOSCRN  ;IF YES

 JSR SETSCRN  ;SET THE DISPLAY SWITCHES FOR EXT2 OUTPUT

:ZPOK LDA #$FF  ;SET THIS FLAG TO INDICATE THAT
 STA RESTFLAG ; SCREEN RAM AREA HAS BEEN DISTURBED

:NOSCRN PLA
 TAY   ;RESTORE Y
 PLA
 TAX   ;RESTORE ACC & X
 PLA
 RTS

*MUST USE THIS ROUTINE TO AVOID MESSING UP
* THE INPUT BUFFER IN APPLE MEMORY

*GET LINE SUBROUTINE

NOTCR EQU *
 LDA IN,X
 JSR DOCOUT
 CMP #LTARROW ;IS IT LEFT ARROW
 BEQ BCKSPC
 CMP #CTRLX  ;IS IT CTRL X
 BEQ GETLNZ  ;IF YES
 CPX #25  ;RING BELL AFTER 25 CHARACTERS, AS WARNING.
 BLT NOTCR1
GETERR JSR BELL
NOTCR1 INX
 CPX #30  ;LIMIT INPUT LINE TO 30 CHARACTERS
 BNE NXTCHAR

GETLNZ JSR CROUT
GETLN LDA TFLAG  ;TRACE MODE ?
 BEQ GETNOT  ;IF NO
 LDA #"T"  ;INDICATE TRACE MODE
 JSR COUT
GETNOT LDA PROMPT
 JSR COUT
 LDX #$01
BCKSPC TXA
 BEQ GETNOT
 DEX
NXTCHAR JSR RDCHAR
GETLNNO CMP #UPARROW ;UP ARROW ?
 BEQ NXTCHAR  ;IF YES IGNORE
 CMP #ESC  ;esc key?
 BNE :CKRAROW ;if no
 RTS   ;returns with Carry set if ESC key

:CKRAROW CMP #RTARROW ;RIGHT ARROW ?
 BNE :DELTST  ;IF NO
 LDY MEMHORZ  ;SCREEN MEM POINTER

* ODD OR EVEN COLUMN

 LDA CURSHORZ ;COLUMN NUMBER
 LSR   ;SET CARRY IF ODD
 BCS :AROWMAIN ;ODD COLUMN IS MAIN MEM.
 PHP
 SEI
 STA TXTPAGE2 ;AUX ON
 LDA (BASL),Y ;GET CHAR
 STA TXTPAGE1 ;MAIN ON
 PLP
 BCC :DELTST  ;<ALWAYS>
:AROWMAIN
 LDA (BASL),Y
:DELTST CMP #DELETE
 BNE :CHKDAROW
 LDA #LTARROW ;IF YES MAKE IT LEFT ARROW
:CHKDAROW
 CMP #DNARROW ;DOWN ARROW ?
 BNE :CAPTST  ;IF NO
* IT IS DOWN ARROW, IF TRACING SKIP NEXT INSTRUCTION
 BIT TFLAG  ;TRACING ?
 BEQ :MAKECR  ;NOT TRACING
 LDA #">"  ;MAKE ">"
 STA IN,X  ;PUT IN BUFFER
 INX
 BNE :MAKECR  ;FOLLOW WITH <CR>
 
:CAPTST CMP #$E0
 BLT :ADDINP
 AND #$DF  ;SHIFT TO UPPER CASE
:ADDINP STA IN,X  ;STORE CHAR IN BUFFER
 CMP #CR  ;IS IT CARRIAGE RETURN
 BEQ :MAKECR  ;IF YES
 JMP NOTCR  ;IF NO
:MAKECR JMP CROUT  ;SEND CR AND RETURN

* MAKES REACHING RIGHT EDGE OF WINDOW LOOK LINE <CR>

DOCOUT JSR COUT  ;OUTPUT
 LDY CURSHORZ
 INY
 CPY WINDWDTH ;END OF DATA AREA
 BLT :OK  ;IF NO, RETURN TO GETLN
 PLA
 PLA   ;RETURN TO CALLER OF GETLN
 INX   ;INCLUDE LAST CHAR
 JMP CROUT
:OK RTS
 
BELLONE CMP #$87  ;CTRL-G?
 BNE BELLRTS
 LDY #$A0
BELLTWO LDA #$0F
 JSR WAIT
 LDA SPKR
 DEY
 BNE BELLTWO
BELLRTS RTS

OUTPUT LDY CURSHORZ
 PHA   ;SAVE ACC
 TYA
 LSR   ;DIVIDE BY 2
 STA MEMHORZ  ;SCREEN MEMORY POINTER
 TAY
 PLA   ;RESTORE ACC. (CARRY NOT AFFECTED)
 BCS OUTMAIN  ;MAIN MEMORY
 JSR WRITEAUX ;WRITE ACC. TO AUX MEM.
 BCC INCCH  ;<ALWAYS>
OUTMAIN STA (BASL),Y
INCCH INC CURSHORZ
 LDA CURSHORZ
 CMP WINDWDTH
 BCS RETURN
 RTS

****** EXTERMINATOR II COUT *****

* OUTPUT A CHARACTER TO THE SCREEN WINDOW.
* IF THE RIGHT SIDE OF THE WINDOW IS REACHED, THEN
* SCROLL ALL LINES IN THE WINDOW UP 1 AND POSITION
* THE CURSOR AT BOTTOM LEFT.
*
* WINDOWS MUST HAVE AN EVEN NUMBER FOR THE LEFT EDGE
*

TOCOUT STY YBUF2
 PHA
 JSR VIDOUT
 PLA
 LDY YBUF2
 RTS

VIDOUT CMP #$A0  ;CONTROL CHAR?
 BGE OUTPUT  ;IF NO
 TAY   ;OOSOTIVE #?
 BPL OUTPUT  ;IF YES
 CMP #$8A  ;LINE FEED?
 BEQ LINEFEED ;IF YES
 CMP #$8D  ;CR?
 BEQ RETURN  ;IF YES
 CMP #$88  ;LEFT ARROW?
 BNE BELLONE  ;IF NO CHECK FOR BELL
BACKSPAC
 DEC CURSHORZ ;DECRMENT CURSOR HORIZ POSITION
 BPL LEFTRTS  ;POS IF NOT PAST LEFT EDGE
 INC CURSHORZ ;PUT BACK TO 0 AT LEFT EDGE OF WINDOW
LEFTRTS RTS

RETURN LDA #0
 STA CURSHORZ ;PUT CURSOR TO LEFT EDGE OF WINDOW
LINEFEED
 INC CURSVERT ;CURSOR DOWN 1 LINE
 LDA CURSVERT
 CMP WINDBTM  ;CHECK FOR WINDOW BOTTOM?
 BCC SETBASE  ;NO, SET NEW BASE ADDRESS
 DEC CURSVERT ;OFF BOTTOM, SO PUT BACK TO BOTTOM
SCROLL LDA WINDTOP  ;START AT TOP
 PHA
 JSR SETBASE  ;CALC BASE ADDRESS
 STX XBUFF  ;SAVE X
SCROLL1 LDA BASL  ;COPY BASL,X
 STA BAS2L  ;TO BAS2L,H
 LDA BASH
 STA BAS2H
 LDX WINDWDTH ;INIT X TO RIGHTMOST INDEX
 DEX   ;PUT IN 0-79 TERMS
 PLA
 ADC #$01  ;INCR LINE NUMBER
 CMP WINDBTM  ;DONE?
 BCS SCROLL3  ;YES
 PHA
 JSR SETBASE  ;CALC BASL,A
SCROLL2 
 TXA
 LSR   ;DIVIDE BY 2
 TAY
 BCS SCRLMAIN ;MAIN MEMORY
 LDA TXTPAGE2 ;AUX MEM ON
SCRLMAIN
 LDA (BASL),Y
 STA (BAS2L),Y
 BCS :SPEED  ;THIS IS FASTER
 LDA TXTPAGE1 ;MAIN MEM
:SPEED DEX   ;SHIFT LEFT ONE CHAR
 BPL SCROLL2
 BMI SCROLL1
SCROLL3 LDX XBUFF  ;RESTORE X
 LDY #$0  ;CLEAR BOTTOM LINE
 JSR CLEOLZ

VTAB LDA CURSVERT
SETBASE BIT IOMODE  ;DON'T CHANGE BASL,H IF NOT SCREEN I/O
 BMI :SKIP  ;IF SERIAL I/O
 BVS :SKIP  ;IF SLOT 1 I/O
 BIT OFFFLAG  ;DISPLAY OFF ?
 BMI :SKIP  ;IF YES
* CALC BASE ADDRESS IN BASL,H
 PHA   ;CALC BASE ADR IN BASL,H
 LSR   ;FOR GIVEN LINE NUMBER
 AND #$03  ;0<=LINE NO.<=$17
 ORA #$04
 STA BASH
 PLA
 AND #$18
 BCC :BSCLC2
 ADC #$7F
:BSCLC2 STA BASL
 ASL
 ASL
 ORA BASL
 STA BASL

 LDA WINDLEFT
 LSR   ;DIVIDE BY 2
 CLC
 ADC BASL
 STA BASL
:SKIP RTS

CLREOL LDY CURSHORZ
CLEOLZ STY MEMHORZ

* DON'T CLEAR IF NOT SCREEN I/O
 LDA IOMODE
 BNE :NOCLR

:CLEOL2 LDY MEMHORZ
 TYA
 LSR   ;DIVIDE BY 2, CARRY SET IF ODD COLUMN
 TAY
 LDA #$A0
 BCS :CLEAR40 ;DON'T CLEAR 1ST EVEN COL IF SETTING ON ODD
 JSR WRITEAUX ;WRITE TO SCREEN
 BCC :CLRCHK  ;<ALWAYS>
:CLEAR40
 STA (BASL),Y ;WRITE SPACE
:CLRCHK INC MEMHORZ
 LDA MEMHORZ
 CMP WINDWDTH ;END OF THE LINE?
 BLT :CLEOL2  ;IF NO
:NOCLR RTS

***** CLEAR AND HOME WITHIN WINDOW *****

CLRHOME LDY WINDTOP  ;START AT TOP
 STY CURSVERT
CLRBOT JSR VTAB  ;INIT BASL & BASH
 LDY #0
 JSR CLEOLZ  ;CLEAR LINE
 INC CURSVERT ;NEXT LINE
 LDA CURSVERT
 CMP WINDBTM  ;BOTTOM?
 BLT CLRBOT  ;IF NO

* HOME WITHOUT CLEAR

HOME
 LDY #0
 STY CURSHORZ ;LEFT EDGE
 LDY WINDTOP  ;FINISHED	
 STY CURSVERT
 JMP VTAB

***** WAIT *****

WAIT SEC
WAIT2 PHA
WAIT3 SBC #$01
 BNE WAIT3
 PLA
 SBC #$01
 BNE WAIT2
 RTS

* SUBROUTINES USED ABOVE

* WRITE THE CONTENTS OF THE ACC. TO
* AUX SCREEN MEMORY.

WRITEAUX
 STA TXTPAGE2 ;AUX ON
 STA (BASL),Y ;PUT ON SCREEN
 STA TXTPAGE1 ;MAIN ON
 RTS

* SET THE SCREEN SWITCHES FOR OUTPUT BY THE EXT2.

SETSCRN LDA #0
 STA INITFLAG ;<TEMPORARY HERE> SHOW THAT APPLE SETUP SAVED
 STA TEXTON  ;TEXT MODE
 STA MIXEDOFF ;ALL TEXT
 STA COL80ON  ;80 COL DISP. ON
 STA STR80ON  ;ALLOW TXTPAGE1 TO SWITCH MAIN/AUX
 STA TXTPAGE1 ;PAGE1 OR MAIN MEM
 JMP VTAB  ;INIT BASL TO LAST ACTIVE EXT WINDOW

***** DISPLAY THE FLAG WINDOW *****

FLGMOFF HEX 00,00,00,0A,14,1E,1E,1E

ANDDSFL HEX 02,01,04,10,20

DISFLGW
 LDA IOMODE  ;DON'T DISPLAY IF NOT SCREEN I/O
 BEQ :NOTSER  ;IF SCREEN I/O
 RTS

* SET WINDOW LIMITS, START AT 2ND LINE DOWN

:NOTSER LDA #1
 STA WINDTOP
 LDA #42
 STA WINDLEFT
 LDA #38
 STA WINDWDTH
 LDA #5
 STA WINDBTM
 JSR HOME

* DISPLAY 1ST ROW OF FLAGS

 LDX #5
 JSR PRBL2  ;5 SPACES
 LDA MSTATE  ;MACHINE STATE
 PHA
 LDX #0
:NEXT LDY FLGMOFF,X
 PLA
 ROL
 PHA
 JSR FLAGDISP
 INX
 CPX #8
 BNE :NEXT
 PLA
 LDY #MSGCR-MSGSWSET
 JSR BIT0

* DISPLAY 2ND ROW OF FLAGS

 LDA KEY  ;COMMAND PREFIX KEY
 JSR PRBYTE  ;DISPLAY AS HEX
 LDX #2
 JSR PRBL2  ;2 SPACES
 LDY #MSGOUT-MSGSWSET
 SEC
 LDA REALBRK  ;0=NO REAL BRKS
 BNE :BRK  ;IF REAL BRKS
 CLC
:BRK JSR FLAGDISP
 LDY #MSG02-MSGSWSET
 CLC
 LDA CMOSFLAG ;TYPE 02, C02, OR 816
 BEQ :TYP  ;02
 SEC
 BMI :TYP  ;C02
 CLC
 LDY #MSG816-MSGSWSET ;816
:TYP JSR FLAGDISP
 LDY #MSGOFF-MSGSWSET
 STY YBUFF
 CLC
 LDA INVISIBL ;INVIS MODE FLAG
 BPL :INV  ;IF OFF
 SEC
:INV JSR FLAGDISP
 LDX #4
:NEXTDF CLC
 LDA DISPFLAG
 AND ANDDSFL,X ;TEST PROPER BIT
 BEQ :NOTSET
 SEC
:NOTSET JSR FLAGDISP
 DEX
 BPL :NEXTDF
 RTS

FLAGDISP
 BCC BIT0
 INY
 INY
 INY
 INY
 INY
BIT0 JSR WRITMOR7
:MORE LDA MSGSWSET,Y
 JSR WRITECK7
 BCC :MORE
 RTS

* THIS ROUTINE MUST BE ABOVE $CF00

WRITMOR7
 BIT $C800  ;DISABLE EXT RAM
 CLC
 RTS
WRITECK7
 BIT $CF00  ;ENABLE EXT RAM
 INY   ;NEXT CHARACTER
 CMP #EOT  ;FINISHED?
 BEQ WRITDON7 ;IF YES, CARRY ALSO SET
 JSR COUT  ;DISPLAY CHARACTER
 JMP WRITMOR7
WRITDON7
 LDY YBUFF  ;RESTORE
 RTS

***** DISPLAY MEMORY WINDOW *****

DISMEMW
 LDA IOMODE  ;DISPLAY ONLY IF SCREEN I/O
 BNE :END  ;IF NOT SCREEN I/O

* SET WINDOW LIMITS

 LDA #6
 STA WINDTOP
 LDA #42
 STA WINDLEFT
 LDA #13
 STA WINDWDTH
 LDA #18
 STA WINDBTM
 JSR HOME

* DISPLAY SELECTED MEMORY LOCATIONS

 LDX #11*3  ;0-11 LOCATIONS 3 BYTES EACH
:NEXTMEM
 LDA MEMWADR,X ;GET DATA
 STA PBRADD
 LDA MEMWADR+1,X
 STA HIADD
 LDA MEMWADR+2,X
 STA LOWADD
 JSR DSMWASC  ;DISPLAY MEM W/ASCII
 CPX #0  ;AVOID SCROLL
 BEQ :END
 JSR RETURN
 DEX
 DEX
 DEX
 BPL :NEXTMEM
:END RTS

***** DISPLAY THE EFFECTIVE ADDRESS WINDOW *****

DISEFFW
 LDA IOMODE  ;DISPLAY ONLY IF SCREEN I/O
 BNE :END  ;IF NOT SCREEN I/O

* SET WINDOW LIMITS

 LDA #19
 STA WINDTOP
 LDA #42
 STA WINDLEFT
 LDA #13
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR HOME

* GET EFFECTIVE ADDRESS

 LDA EFFADRS+2 ;PBR OF EFFECTIVE ADRS
 STA PBRADD
 LDA EFFADRS+1
 STA HIADD
 LDA EFFADRS
 STA LOWADD

*START DISPLAY 2 BYTES BEFORE EFF ADRS

 SEC
 SBC #2
 STA LOWADD
 LDA HIADD
 SBC #0
 STA HIADD

* DISPLAY 5 BYTES

 LDX #4
:NEXTEFF
 LDA HIADD
 CMP #$C0  ;DO NOT DISPLAY SOFT SWITCHES
 BEQ :NEXT
 JSR DSMWASC  ;DISPLAY MEM W/ASCII
:NEXT CLC
 LDA LOWADD
 ADC #1  ;INC POINTER
 STA LOWADD
 LDA HIADD
 ADC #0
 STA HIADD

 CPX #0  ;AVOID SCROLL
 BEQ :END
 JSR RETURN
 DEX
 BPL :NEXTEFF
:END RTS

***** DISPLAY THE BRK WINDOW *****

DISBRKW
 LDA IOMODE  ;DISPLAY ONLY IF SCREEN I/O
 BNE :DSEND  ;IF NOT SCREEN I/O

* SET WINDOW LIMITS

 LDA #6
 STA WINDTOP
 LDA #56
 STA WINDLEFT
 LDA #15
 STA WINDWDTH
 LDA #17
 STA WINDBTM
 JSR HOME

* DISPLAY THE MOST RECENT BRK INFO
* START WITH HARD BRK

 JSR SPACE  ;SPACE
 LDA #"H"
 JSR COUT
 JSR TRANSFR7 ;DISPLAY HARD BRK IF ANY
 DFB DSPHBPC  ;code
 JSR CROUT

* DISPLAY OTHER BRKS

 LDY POINT  ;BRK STACK
 BEQ :DSEND  ;IF NO BRKS
 LDX #9  ;DO 10 BRKS
:NEXTBP STX XBUFF
 DEY   ;POINT AT LAST BRK
 JSR SPACE  ;SPACE
 JSR TRANSFR7 ;DISPLAY 1 BRK
 DFB DSPBRKC  ;code
 CPY #0  ;FINISHED ?
 BEQ :DSEND  ;IF YES
 LDX XBUFF
 CPX #0  ;AVOID SCROLL
 BEQ :DSEND
 JSR RETURN
 DEX
 BPL :NEXTBP
:DSEND RTS

***** DISPLAY PROTECTION WINDOW *****

DISPROTW
 LDA IOMODE  ;SCREEN I/O ?
 BNE :END  ;IF NOT

* SET WINDOW LIMITS

 LDA #18
 STA WINDTOP
 LDA #56
 STA WINDLEFT
 LDA #15
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR HOME
 
* DISPLAY PROTECTION INFO

 LDX #6*5  ;6 BUFFERS WITH 0-5 BYTES EACH
:NEXTPRT
 JSR SPACE  ;1 SPACE
 LDA PROTADR,X ;GET PROTECTION INFO
 JSR COUT  ;TYPE OF PROT
 LDA PROTADR+1,X
 STA PBRADD
 LDA PROTADR+2,X
 STA HIADD
 LDA PROTADR+3,X
 STA LOWADD
 JSR DSPADRS  ;DISPLAY 24 BIT ADDRESS
 LDA #"."
 JSR COUT
 LDA PROTADR+4,X
 STA HIADD
 LDA PROTADR+5,X
 STA LOWADD
 JSR DSP16ADR ;DISPLAY 16 BIT ADDRESS
 CPX #0  ;AVOID SCROLL
 BEQ :END
 JSR RETURN
 TXA
 SEC
 SBC #6  ;NEXT PROT BUFFER
 TAX
 BPL :NEXTPRT
:END RTS

***** DISPLAY STACK WINDOW *****

DISSTKW
 LDA IOMODE  ;SCREEN I/O ?
 BNE :DSEND  ;IF NOT

* SET WINDOW LIMITS, START AT 2ND LINE DOWN

 LDA #6
 STA WINDTOP
 LDA #72
 STA WINDLEFT
 LDA #8
 STA WINDWDTH
 LDA #24
 STA WINDBTM
 JSR HOME

* DISPLAY 18 BYTES OF STACK INFO

 LDX #17
 STX XBUFF  ;COUNT

* GET STACK LOCATION

 LDA #01  ;HI BYTE OF STACK
 STA HIADD
 LDA STACK  ;LOW BYTE OF STACK POINTER
* START DISPLAY 8 BYTES ABOVE POINTER
 CLC
 ADC #10
 STA LOWADD

:NEXTSTK
 LDX LOWADD  ;LOW BYTE OF STACK
 JSR DSP16ADR ;DISPLAY 16 BIT ADRS

 LDY SLOTN0
***********************************
* WARNING, SEGMENT DEPENDENT CODE
***********************************
 LDA #%01110111 ;RAM 7, ROM 7
 STA SEGMBASE,Y

 LDA STACKBUF,X ;GET FROM EXT RAM
 PHA

***********************************
* WARNING, SEGMENT DEPENDENT CODE
***********************************
 LDA #%00000111 ;RAM 0, ROM 7
 STA SEGMBASE,Y

 LDA #":"
 JSR COUT
 PLA   ;GET DATA BYTE
 JSR PRBYTE
 LDA XBUFF  ;AVOID SCROLL
 BEQ :DSEND
 JSR RETURN
 DEC LOWADD
 DEC XBUFF
 BPL :NEXTSTK
:DSEND RTS

***** DISPLAY FLAG, MEM, EFF, AND STACK WINDOWS *****

DISFMES BIT WINDFLG  ;are windows on?
 BMI :ON  ;If no then do "ON" command

 JSR DISFLGW  ;DISPLAY FLAG WINDOW
 JSR DISMEMW  ;DISPLAY MEM WINDOW
 JSR DISEFFW  ;DISPLAY EFF WINDOW
 JMP DISSTKW  ;DISPLAY STK WINDOW 

:ON JSR TRANSFR7 ;Do "ON"
 DFB DISPONC  ;code
 RTS

***** SUBROUTINES *****

***** DISPLAY 24 BIT ADDRESS *****
* FROM PBRADD, HIADD, LOWADD

DSPADRS LDA PBRADD
 JSR PRBYTE
 LDA #"/"
 JSR COUT

***** ALT ENTRY, DISPLAY 16 BIT ADDRESS *****

DSP16ADR
 LDA HIADD
 JSR PRBYTE
 LDA LOWADD
 JMP PRBYTE

***** DISPLAY 24 BIT ADDRESS WITH HEX AND ASCII *****

DSMWASC JSR DSPADRS  ;DISPLAY 24 BIT ADRS
 JSR DSPCBYT  ;DISPLAY ":" HEX BYTE

* DON"T DISPLAY AS CONTROL CODES

 PHA
 JSR SPACE  ;1 SPACE
 PLA
 BPL :DISOK
 CMP #$A0
 BGE :DISOK
 ORA #$40  ;CHANGE TO UPPER CASE
:DISOK JMP COUT  ;DISPLAY ASCII

***** DISPLAY ":" WITH HEX DATA *****

DSPCBYT LDA #":"
 JSR COUT
 LDY #0
 JSR TRANSFR7 ;GET CHAR
 DFB LDAINDYC ;code
 PHA
 JSR PRBYTE  ;DISPLAY AS HEX
 PLA
 RTS

******* SAVE THE ACC, X AND P REGISTERS *****

SAVEAXP7
 PHP   ;SAVE STATUS
 STX XSAVESEG
 STA ASAVESEG
 PLA   ;GET STATUS
 STA PSAVESEG ;SAVE
 RTS

****** RESTORE THE ACC, X AND P REGISTERS *****

RESTAXP7
 LDX XSAVESEG
 LDA PSAVESEG
 PHA
 LDA ASAVESEG
 PLP
 RTS

***** THIS SEGMENTS GLOBAL SUBROUTINES *****

SUBTABL7

COUTC EQU *-SUBTABL7*4+7+$100
 DA COUT-1

CROUTC EQU *-SUBTABL7*4+7+$100
 DA CROUT-1

RDCHARC EQU *-SUBTABL7*4+7+$100
 DA RDCHAR-1

PRERRC EQU *-SUBTABL7*4+7+$100
 DA PRERR-1

PRBL2C EQU *-SUBTABL7*4+7+$100
 DA PRBL2-1

PRBLNKC EQU *-SUBTABL7*4+7+$100
 DA PRBLNK-1

PRBYTEC EQU *-SUBTABL7*4+7+$100
 DA PRBYTE-1

PRNTAXC EQU *-SUBTABL7*4+7+$100
 DA PRNTAX-1

PRHEXC EQU *-SUBTABL7*4+7+$100
 DA PRHEX-1

RECEIVEC EQU *-SUBTABL7*4+7+$100
 DA RECEIVE-1

GETLNC EQU *-SUBTABL7*4+7+$100
 DA GETLN-1

GETLNZC EQU *-SUBTABL7*4+7+$100
 DA GETLNZ-1

GETLNNOC EQU *-SUBTABL7*4+7+$100
 DA GETLNNO-1

CLREOLC EQU *-SUBTABL7*4+7+$100
 DA CLREOL-1

BELLC EQU *-SUBTABL7*4+7+$100
 DA BELL-1

WAITC EQU *-SUBTABL7*4+7+$100
 DA WAIT-1

SETSCRNC EQU *-SUBTABL7*4+7+$100
 DA SETSCRN-1

VTABC EQU *-SUBTABL7*4+7+$100
 DA VTAB-1

CLRHOMEC EQU *-SUBTABL7*4+7+$100
 DA CLRHOME-1

HOMEC EQU *-SUBTABL7*4+7+$100
 DA HOME-1

DISFLGWC EQU *-SUBTABL7*4+7+$100
 DA DISFLGW-1

DISMEMWC EQU *-SUBTABL7*4+7+$100
 DA DISMEMW-1

DISEFFWC EQU *-SUBTABL7*4+7+$100
 DA DISEFFW-1

DISBRKWC EQU *-SUBTABL7*4+7+$100
 DA DISBRKW-1

DISPROTWC EQU *-SUBTABL7*4+7+$100
 DA DISPROTW-1

DISSTKWC EQU *-SUBTABL7*4+7+$100
 DA DISSTKW-1

DISFMESC EQU *-SUBTABL7*4+7+$100
 DA DISFMES-1

*********************************
**** SEGMENT CROSSOVER AREA *****
*********************************

 LST ON
S7END = $CF9D-*
 do nolist
 LST OFF
 fin
 ERR *-1/$CF9D
 DS $CF9D-*,$FF

MAIN107 JSR SAVEAXP7 ;COME HERE TO TRANSFER TO SEGMENT0 DIRECTLY
 LDX SLOTN0
 LDA #%00000101 ;RAM0,ROM5
 STA SEGMBASE,X ;NEXT INSTRUCTION EXECUTED FROM SEGMENT 5
 JSR RESTAXP7 ;RESTORE AFTER TRANSFER FROM SEGMENT 5
 RTS  ;GOTO COMMANDS IN THIS SEGMENT
 NOP
 NOP  ;MATCH LENGTH WITH SEG 5

* TRANSFER TO OTHER SEGMENTS

TRANSFR7

 JSR SAVEAXP7
 PLA   ;GET RETRUN ADDRESS FROM STACK
 CLC
 ADC #1  ;INC TO POINT AT CODE BYTE
 STA TEMPSEG  ;SETUP LDA TEMPSEG ROUTINE
 PLA
 ADC #0  ;ADD CARRY, IF ANY
 STA TEMPSEG+1 ;SETUP LDA TEMPSEG ROUTINE
 PHA
 LDA TEMPSEG
 PHA   ;BUMP RETURN ADDRESS PAST CODE BYTE
 LDA #7  ;CURRENT SEG #
 PHA
 JSR LDATEMP  ;LOAD CODE BYTE
 STA SEGMCODE ;SAVE CODE
 AND #$07  ;STRIP ALL BUT SEG #
 LDX SLOTN0
 STA SEGMBASE,X ;NEXT INSTR. RUN FROM NEW SEGMENT
* NEW SEGMENT
 LDA #>RETURN7 ;WHERE TO RETURN TO
 PHA
 LDA #RETURN7
 PHA
 LDA SEGMCODE ;CODE BYTE
 AND #$F8  ;STIP OFF SEG# LEAVING SUB #
 LSR
 LSR   ;LEAVE SUB# MULTIPLIED BY 2
* GET ADDRESS OF SUB FROM SUBTABL & PUSH ON STACK
 TAX
 LDA SUBTABL7+1,X
 PHA
 LDA SUBTABL7,X
 PHA

 JSR RESTAXP7 ;RESTORE REGISTERS
 RTS   ;USE RTS TO GOTO SUB

* RETURN HERE FROM SUBROUTINE

RETURN7 EQU *-1
 JSR SAVEAXP7
 PLA   ;SEG # TO RETURN TO
 LDX SLOTN0
 STA SEGMBASE,X ;RETURN TO SEGMENT
 JSR RESTAXP7
 RTS   ;RETURN TO PROGRAM

 DS \,$FF ;PUT OBJECT AT NEXT PAGE
